home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0086_Accessing DBASE3 Files.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-03  |  10KB  |  307 lines

  1. unit dbaseiii;
  2. { unit including procedures for accessing DBaseIII files}
  3.  
  4. interface
  5.  
  6. uses Crt;
  7.  
  8. Procedure OpenDBFData;
  9. Procedure OpenDBFMemo;
  10. Procedure ReadDBFRecord(I : Longint);
  11. Procedure WriteDBFRecord;
  12. Procedure ReadDBFMemo(BlockNumber : integer);
  13. Procedure WriteDBFMemo(var BlockNumberString : string);
  14. Procedure CloseDBFData;
  15. Procedure CloseDBFMemo;
  16.  
  17. const
  18.         DBFMaxRecordLength = 4096;
  19.         DBFMemoBlockLength =  512;
  20.         DBFMaxMemoLength   = 4096;
  21.  
  22. type
  23.         DBFHeaderRec = Record
  24.                 HeadType                : byte;
  25.                 Year                        : byte;
  26.                 Month                        : byte;
  27.                 Day                                : byte;
  28.                 RecordCount                : longint;
  29.                 HeaderLength        : integer;
  30.                 RecordSize          : integer;
  31.                 Garbage                         : array[1..20] of byte;
  32.         end;
  33.  
  34. type
  35.         DBFFieldRec = Record
  36.                 FieldName                : array[1..11] of char;
  37.                 FieldType                : char;
  38.                 Spare1,
  39.                 Spare2                        : integer;
  40.                 Width                        : byte;
  41.                 Dec                                : byte;
  42.                 WorkSpace                : array[1..14] of byte;
  43.         end;
  44.  
  45. var
  46.         DBFFileName                         : string;
  47.  
  48.         DBFDataFile                                : File;
  49.         DBFDataFileAvailable        : boolean;
  50.         DBFBuffer                                : array [1..DBFMaxRecordLength] of char;
  51.  
  52.         DBFHeading                                : DBFHeaderRec;
  53.  
  54.         DBFField                                : DBFFieldRec;
  55.         DBFFieldCount                        : integer;
  56.         DBFFieldContent                        : array [1..128] of string;
  57.  
  58.         DBFNames                                : array [1..128] of string[10];
  59.         DBFLengths                                : array [1..128] of byte;
  60.         DBFTypes                                : array [1..128] of char;
  61.         DBFDecimals                                : array [1..128] of byte;
  62.         DBFContentStart                        : array [1..128] of integer;
  63.  
  64.         DBFMemoFile                                : File;
  65.         DBFMemoFileAvailable        : boolean;
  66.         DBFMemoBuffer                        : Array [1..DBFMemoBlockLength] of byte;
  67.         DBFMemo                                        : Array [1..DBFMaxMemoLength] of char;
  68.  
  69.         DBFMemoLength                        : integer;
  70.         DBFMemoEnd                                : boolean;
  71.         DBFMemoBlock                        : integer;
  72.  
  73.         DBFDeleteField                        : char;
  74.         DBFFieldStart                        : integer;
  75.  
  76.         DBFRecordNumber                        : longint;
  77.  
  78. (****************************************************************)
  79.  
  80. implementation
  81.  
  82. (****************************************************************)
  83.  
  84. Procedure ReadDBFHeader;
  85.  
  86. var
  87.         RecordsRead : integer;
  88.  
  89. begin
  90.         BlockRead (DBFDataFile, DBFHeading, SizeOf(DBFHeading), RecordsRead);
  91. end;
  92.  
  93. (*****************************************************************)
  94.  
  95. Procedure ProcessField (F : DBFFieldRec;
  96.                                                 I : integer);
  97. var
  98.         J : integer;
  99.  
  100. begin
  101.         with F do
  102.         begin
  103.                 DBFNames [I] := '';
  104.                 J := 1;
  105.                 while (J<11) and (FieldName[J] <> #0) do
  106.                         begin
  107.                                 DBFNames[I] := DBFNames[I] + FieldName [J];
  108.                                 J := J + 1;
  109.                         end;
  110.                 DBFLengths [I]                 := Width;
  111.                 DBFTypes [I]                 := FieldType;
  112.                 DBFDecimals [I]         := Dec;
  113.                 DBFContentStart [I] := DBFFieldStart;
  114.                 DBFFieldStart                 := DBFFieldStart + Width;
  115.         end;
  116. end;
  117.  
  118. (***************************************************************)
  119.  
  120. Procedure ReadFields;
  121.  
  122. var
  123.         I                         : integer;
  124.         RecordsRead : integer;
  125.  
  126. begin
  127.         Seek(DBFDataFile,32);
  128.         I := 1;
  129.         DBFFieldStart := 2;
  130.         DBFField.FieldName[1] := ' ';
  131.         while (DBFField.FieldName[1] <> #13) do
  132.                 begin
  133.                         BlockRead(DBFDataFile,DBFField.FieldName[1],1);
  134.                         if (DBFField.FieldName[1] <> #13) then
  135.                                 begin
  136.                                         BlockRead(DBFDataFile, DBFField.FieldName[2],SizeOf(DBFField) - 1, RecordsRead);
  137.                                         ProcessField (DBFField, I);
  138.                                         I := I + 1;
  139.                                 end;
  140.                 end;
  141.         DBFFieldCount := I - 1;
  142. end;
  143.  
  144. (***********************************************************)
  145.  
  146. Procedure OpenDBFData;
  147.  
  148. begin
  149.         DBFDataFileAvailable := false;
  150.         Assign(DBFDataFile, DBFFileName+'.DBF');
  151.  
  152. {$I-}
  153.         Reset(DBFDataFile,1);
  154.         If IOResult<>0 then exit;
  155. {$I+}
  156.  
  157.         DBFDataFileAvailable := true;
  158.         Seek(DBFDataFile,0);
  159.         ReadDBFHeader;
  160.         ReadFields;
  161. end;
  162.  
  163. (******************************************************************)
  164.  
  165. Procedure CloseDBFData;
  166.  
  167. begin
  168.         if DBFDataFileAvailable then Close(DBFDataFile);
  169. end;
  170.  
  171. (*******************************************************************)
  172.  
  173. Procedure OpenDBFMemo;
  174.  
  175. begin
  176.         DBFMemoFileAvailable := false;
  177.         Assign(DBFMemoFile, DBFFileName+'.DBT');
  178.  
  179. {$I-}
  180.         Reset(DBFMemoFile,1);
  181.         If IOResult<>0 then exit;
  182. {$I+}
  183.  
  184.         DBFMemoFileAvailable := true;
  185.         Seek(DBFMemoFile,0);
  186. end;
  187.  
  188. (*******************************************************************)
  189.  
  190. Procedure CloseDBFMemo;
  191.  
  192. begin
  193.         If DBFMemoFileAvailable then close(DBFMemoFile);
  194. end;
  195.  
  196. (*******************************************************************)
  197.  
  198. Procedure GetDBFFields;
  199.  
  200. var
  201.         I                         : byte;
  202.         J                         : integer;
  203.         Response         : string;
  204.  
  205. begin
  206.         DBFDeleteField := DBFBuffer[1];
  207.         For I:=1 to DBFFieldCount do
  208.                 begin
  209.                         DBFFieldContent[I] := '';
  210.                         For J := DBFContentStart[I] to DBFContentStart [I] + DBFLengths[I] -1 do
  211.                                 DBFFieldContent[I] := DBFFieldContent[I] + DBFBuffer[J];
  212.                         For J := 1 to DBFLengths[I] do
  213.                                 if DBFFieldContent[J]=#0 then DBFFieldContent[J]:=#32;
  214.                 end;
  215. end;
  216.  
  217. (***********************************************************************)
  218.  
  219. Procedure ReadDBFRecord (I : Longint);
  220.  
  221. var
  222.         RecordsRead : integer;
  223.  
  224. begin
  225.         Seek(DBFDataFile, DBFHeading.HeaderLength + DBFHeading.RecordSize * (I - 1));
  226.         BlockRead (DBFDataFile, DBFBuffer, DBFHeading.RecordSize, RecordsRead);
  227.         GetDBFFields;
  228. end;
  229.  
  230. (**********************************************************************)
  231.  
  232. Procedure ReadDBFMemo(BlockNumber : integer);
  233.  
  234. var
  235.         I                         : integer;
  236.         RecordsRead        : word;
  237.  
  238. begin
  239.         DBFMemoLength := 0;
  240.         DBFMemoEnd := false;
  241.         If not DBFMemoFileAvailable then
  242.                 begin
  243.                         DBFMemoEnd := true;
  244.                         exit;
  245.                 end;
  246.         FillChar(DBFMemo[1],DBFMaxMemoLength,#0);
  247.         Seek(DBFMemoFile,BlockNumber*DBFMemoBlockLength);
  248.         repeat
  249.                 BlockRead(DBFMemoFile,DBFMemoBuffer,DBFMemoBlockLength,RecordsRead);
  250.                 For I := 1 to RecordsRead  do
  251.                         begin
  252.                                 DBFMemoLength := DBFMemoLength + 1;
  253.                                 DBFMemo[DBFMemoLength] := chr(DBFMemoBuffer[I] and $7F);
  254.                                 If (DBFMemoBuffer[I] = $1A) or (DBFMemoBuffer[I] = $00) then
  255.                                         begin
  256.                                                 DBFMemoEnd := true;
  257.                                                 DBFMemoLength := DBFMemoLength - 1;
  258.                                                 exit;
  259.                                         end;
  260.                         end;
  261.         until DBFMemoEnd;
  262. end;
  263.  
  264. (*********************************************************************)
  265.  
  266. Procedure WriteDBFMemo  {(var BlockNumberString : string)};
  267.  
  268. var
  269.         K : integer;
  270.         ReturnCode : integer;
  271.  
  272. begin
  273.         Val(BlockNumberString,DBFMemoBlock,ReturnCode);
  274.         If ReturnCode>0 then DBFMemoBlock := 0;
  275.         If DBFMemoBlock>0 then
  276.                 begin
  277.                         Writeln;
  278.                         ReadDBFMemo(DBFMemoBlock);
  279.                         If DBFMemoLength=0 then exit;
  280.                         For K := 1 to DBFMemoLength do
  281.                                 Write(DBFMemo[K]);
  282.                         WriteLn;
  283.                 end;
  284. end;
  285.  
  286. (****************************************************************)
  287.  
  288. Procedure WriteDBFRecord;
  289.  
  290. var
  291.         J : byte;
  292.  
  293. begin
  294.         For J := 1 to DBFFieldCount do
  295.                 begin
  296.                         Write(DBFNames[J]);
  297.                         GoToXY(12,J);
  298.                         WriteLn(DBFFieldContent[J]);
  299.                         if DBFTypes[J]='M' then WriteDBFMemo(DBFFieldContent[J]);
  300.                 end;
  301. end;
  302.  
  303. (*******************************************************************)
  304.  
  305. begin
  306. end.
  307.